home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus Special 17 / AMIGAplus Sonderheft 17 (1999)(ICP)(DE)[!].iso / Rexx / Référencer.AmiCAD < prev    next >
Text File  |  1998-08-08  |  5KB  |  191 lines
  1. /* Ajout des références aux composants du type sélectionné ou spécifié
  2.    © R.Florac, Chez Corbin, 2 juin 1998, v1.00
  3.    Version 1.02, 1er juillet 1998: ajout TEST_CIRCUIT pour marquer tous les composants (oubli)
  4.    $VER: Référencer.AmiCAD 1.02 (© R.Florac, 1 juillet 1998) */
  5.  
  6. options results     /* indispensable pour récupérer le résultat des macros */
  7.  
  8. signal on error     /* pour l'interception des erreurs */
  9. signal on syntax
  10.  
  11. 'SELECT("Type de composant à référencer"+CHR(10)+"Résistances"+CHR(10)+"Condensateurs"+CHR(10)+"Diodes"+CHR(10)+"Transistors"+CHR(10)+"Circuits intégrés"+CHR(10)+"Tous les composants"+CHR(10)+"Composants spécifiés")'
  12. choix=result
  13. select
  14.     when choix=1 then do
  15.     reference='R'
  16.     type="Rés#?"
  17.     end
  18.     when choix=2 then do
  19.     reference='C'
  20.     type="Cond#?"
  21.     end
  22.     when choix=3 then do
  23.     reference='D'
  24.     type="Diod#?"
  25.     end
  26.     when choix=4 then do
  27.     reference='Q'
  28.     type="Transist#?"
  29.     end
  30.     when choix=5 then do
  31.     reference="CI"
  32.     type=1
  33.     'DEF TEST_CIRCUIT(N)=IF((TYPE(N)==1) & (TEST(N)==1),1,0)'
  34.     end
  35.     when choix=6 then do
  36.     'SAVEALL(-1)'
  37.     call marquer_composant('R',"Rés#?",-1)
  38.     call marquer_composant('C',"Cond#?",-1)
  39.     call marquer_composant('D',"Diod#?",-1)
  40.     call marquer_composant('Q',"Transist#?",-1)
  41.     'DEF TEST_CIRCUIT(N)=IF((TYPE(N)==1) & (TEST(N)==1),1,0)'       /*  v1.02 */
  42.     call marquer_composant('CI',1,-1)
  43.     exit
  44.     end
  45.     when choix=7 then do
  46.     'ASK("Quel est le nom des"+CHR(10)+"composants à référencer?"+CHR(10)+"Vous pouvez utiliser"+CHR(10)+"les jokers(#?) pour"+CHR(10)+"étendre la sélection")'
  47.     type=result
  48.     if type='' then exit
  49.     'ASK("Quelle est la référence"+CHR(10)+"à donner à ces composants?")'
  50.     reference=result
  51.     if reference='' then exit
  52.     end
  53.     otherwise exit
  54. end
  55. 'N=FIRSTSEL'; obj=result
  56. /* if type=1 then do
  57.     if obj=0 then do
  58.     'MESSAGE("Marquez les circuits"+CHR(10)+"à référencer ainsi que"+CHR(10)+"ceux déjà référencés avant"+CHR(10)+"d''appeler ce script"+CHR(10)+"S.V.P.")'
  59.     exit
  60.     end
  61.     choix=1
  62. end
  63. else do */
  64.     if obj>0 then do
  65.     'REQUEST("Voulez-vous marquer"+CHR(10)+"uniquement les"+CHR(10)+"objets sélectionnés?")'
  66.     choix=result
  67.     end
  68.     else choix=0
  69.     'SAVEALL(-1)'
  70.     call marquer_composant(reference,type,choix)
  71.     exit
  72.  
  73. marquer_composant: procedure
  74.     parse arg reference,type,selection
  75.     if selection<=0 then do
  76.     /* Annulation du marquage éventuel */
  77.     'UNMARK(-1)'
  78.     /* Marquage et comptage des éléments à référencer */
  79.     if type=1 then do
  80.         'SECURITY(OBJECTS(-1)+10):I=0:N=1:WHILE(N<=OBJECTS(-1),IF(TYPE(N)==1,IF(GETDEVS(PARTNAME(N))>0,MARK(N):I=I+1,0),0),N=N+1):I'
  81.     end
  82.     else 'SECURITY(OBJECTS(-1)+10):N=0:I=0:WHILE(I=IF(I+1<=OBJECTS(-1),FINDPART(I+1,"'type'"),0),MARK(I):N=N+1):N'
  83.     n=result
  84.     end
  85.     else do
  86.     /* Comptage des éléments déjà marqués */
  87.     if type=1 then do
  88.         'SECURITY(OBJECTS(-1)+10):I=0:N=FIRSTSEL:WHILE(N,IF(TYPE(N)==1,I=I+1,UNMARK(N)),N=NEXTSEL(N)):I'
  89.     end
  90.     else 'SECURITY(OBJECTS(-1)+10):I=0:WHILE(N,N=FINDPART(N,"'type'"):IF(N>0,IF(TEST(N)>0,I=I+1,0):N=N+1,0)):I'
  91.     n=result
  92.     end
  93.     if n=0 then do
  94.     if selection>=0 then do
  95.         'MESSAGE("Il n''y a aucun"+CHR(10)+"objet de ce type")'
  96.         exit
  97.     end
  98.     else return
  99.     end
  100.  
  101.     /* Test des références, ajout éventuel */
  102.     call test_references(type,reference)
  103.     objet=selection_objet(1,type)
  104.     do i=1 to n
  105.     'GETREF('objet')'; ref=result
  106.     if ref=0 then call ajouter_reference(objet,reference)
  107.     else do
  108.         'READTEXT('ref')'
  109.         j=right(result,length(result)-length(reference))
  110.         if j~="" then do
  111.         ref.i=1
  112.         end
  113.     end
  114.     if i<n then objet=selection_objet(objet+1,type)
  115.     end
  116.  
  117.     /* Écriture des références */
  118.     objet=selection_objet(1,type)
  119.     numref=0
  120.     do i=1 to n
  121.     if ref.i~=1 then do
  122.         numref=numref+1
  123.         do while val.numref=1
  124.         numref=numref+1
  125.         end
  126.         'R=GETREF('objet'):SETTEXT(R,READTEXT(R)+"'numref'"):GETDEVS(PARTNAME('objet'))'
  127.         if result>1 then do
  128.         'SETTEXT(R,READTEXT(R)+CHR(READDEV('objet')+64))'
  129.         end
  130.     end
  131.     if i<n then do
  132.         objet=selection_objet(objet+1,type)
  133.     end
  134.     end
  135.     return
  136. end
  137.  
  138. ajouter_reference: procedure
  139.     parse arg obj,reference
  140.     'LINKREF('obj',WRITE("'reference'",COL('obj')+WIDTH('obj')+5,LINE('obj')+HEIGHT('obj')/2))'
  141.     return
  142. end
  143.  
  144. selection_objet: procedure
  145.     parse arg obj,type
  146.     if type=1 then do
  147.     'R='obj':WHILE(TEST_CIRCUIT(R)<1,R=NEXTSEL(R)):R'
  148.     end
  149.     else do
  150.     'R=FINDPART('obj',"'type'"):WHILE(TEST(R)==0,R=FINDPART(R+1,"'type'")):R'
  151.     end
  152.     return result
  153. end
  154.  
  155. /* Procédure testant et marquant les références déjà existantes */
  156. test_references: procedure expose val.
  157.     parse arg type,reference
  158.     obj=1
  159.     'OBJECTS(-1)';objets=result
  160.     do while obj<=objets
  161.     if type=1 then do
  162.         'RO='obj':WHILE(IF(RO>0,TYPE(RO)<>1,0),RO=NEXTSEL(RO)):RO'; obj=result
  163.     end
  164.     else do
  165.         'FINDPART('obj',"'type'")'; obj=result
  166.     end
  167.     if obj=0 then leave
  168.     'GETREF('obj')'; ref=result
  169.     if ref>0 then do
  170.         'READTEXT('ref')'
  171.         j=right(result,length(result)-length(reference))
  172.         if j~="" then do
  173.         'VAL("'j'")'; j=result
  174.         val.j=1
  175.         end
  176.     end
  177.     obj=obj+1
  178.     end
  179.     return
  180. end
  181.  
  182. /* Traitement des erreurs, interruption du programme */
  183. syntax:
  184. erreur=RC
  185. 'MESSAGE("Script Référencer"+CHR(10)+"Erreur de syntaxe"+CHR(10)+"en ligne 'SIGL'"+CHR(10)+"'errortext(erreur)'")'
  186. exit
  187.  
  188. error:
  189. 'MESSAGE("Script Référencer"+CHR(10)+"Erreur en ligne 'SIGL'")'
  190. exit
  191.